-- card: 18689 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: SystemFolder
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XFCN,SystemFolder,it
end Install


-- part 1 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=80 top=300 right=322 bottom=180
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: SystemFolder
----- HyperTalk script -----
on mouseUp
  answer SystemFolder()
end mouseUp



-- part 2 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 3 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part contents for background part 16
----- text -----
SYSTEMFOLDER XFCN version 1.0.1
Kevin Calhoun

SystemFolder returns the pathname of the folder that contains the currently active System file, appended by a colon.  It's intended for developers of stacks that will reside on read-only media, such as CD-ROM, who need a place to store configuration information and user preferences.  The standard place to store such information is in a file in the system folder.

EXAMPLE
If you wanted to open a file called "SuperStack Prefs" in the system folder, you could use the following HyperTalk code:

   put SystemFolder() & "SuperStack Prefs" into myFile
   open file myFile

22 July 1989 -- Declares the directory ID as a longint in the parameter list of DirIDToPath.

-- part contents for card part 2
----- text -----
UNIT SistimFolder;

{ SystemFolder XFCN ©1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
pascal SystemFolder.p
Link -m ENTRYPOINT ∂
     -o "YourFile" ∂
     -rt XFCN=971 ∂
     -sn Main=SystemFolder ∂
     SystemFolder.p.o ∂
    "{Libraries}"interface.o ∂
    "{PLibraries}"PasLib.o ∂
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE
  USES
    Types,
    Memory,
    Files,
    Packages,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);

IMPLEMENTATION

  PROCEDURE SystemFolder (paramPtr : XCMDPtr); FORWARD;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  BEGIN
    SystemFolder(paramPtr);
  END;
  
  PROCEDURE DirIDToPath(paramPtr: XCMDPtr; dirID: LONGINT; 
                      vRefNum: INTEGER; VAR path: Str255);
  VAR result:  INTEGER;
      str:  Str255;
      pb:   CInfoPBRec;
  BEGIN
    path := '';
    ZeroBytes(paramPtr,@pb,SizeOf(pb));
    pb.ioDirID := dirID;
    WHILE pb.ioDirID <> 1 DO 
      BEGIN
      pb.ioNamePtr := @str;
      pb.ioFDirIndex := -1;
      pb.ioVRefNum := vRefNum;
      IF PBGetCatInfo(@pb,FALSE) <> noErr THEN Exit(DirIDToPath);
      path := Concat(str,':',path);
      pb.ioDirID := pb.ioDrParID;
      END;
  END;
  
  FUNCTION SysRefNum: INTEGER;
    CONST
      SysMap=$A58; { reference number of sysResFile [word] I-114 }
    TYPE
      WordPtr = ^INTEGER;
    VAR
      w: WordPtr;
  BEGIN
    w := WordPtr(SysMap);
    SysRefNum := w^;
  END;

  PROCEDURE SystemFolder(paramPtr: XCMDPtr);
    VAR
      err: OSErr;
      myFCBPBRec: FCBPBRec;
      s: Str255;
  BEGIN
    ZeroBytes(paramPtr, @myFCBPBRec, SIZEOF(FCBPBRec));
    with myFCBPBRec DO
      BEGIN
      ioCompletion := NIL;
      ioNamePtr := NIL;
      ioRefNum := SysRefNum;
      ioFCBIndx := 0;
      END;
    err := PBGetFCBInfo(@myFCBPBRec, FALSE);
    IF err = noErr THEN DirIDToPath(paramPtr, myFCBPBRec.ioFCBParID, myFCBPBRec.ioFCBVRefNum, s);
    IF err <> noErr THEN
      BEGIN
      NumToStr(paramPtr, err, s);
      s := CONCAT('Error ', s);
      END;
    paramPtr^.returnValue := PasToZero(paramPtr, s);
  END;

END.